home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #06 (Feb 86) / pascal 2.2 / Four_Tone_test < prev    next >
Text File  |  1985-12-20  |  2KB  |  84 lines
  1. program A_Basic_Scale;
  2.  uses
  3.   Sane;
  4.  type{ for MyStartSound }
  5.   Ptr = ^integer;
  6.   ParamBlockFake = array[0..30] of integer;
  7.  var
  8.   rate1 : integer;
  9.   MyFTSynth : FTSynthRec;
  10.   myFTSound : FTSoundRec;
  11.   SinWave : packed array[0..255] of char;
  12.  
  13.   blockA, blockB : ParamBlockFake;{ for myStartSound }
  14.   AUsed : boolean;{ for MyStartSound }
  15.  
  16.  procedure MyStartSound (SynthRec : ptr;
  17.          numbytes : longint;
  18.          CompletionRtn : Ptr);
  19.   var
  20.    regs : array[0..12] of longint; { for generic }
  21.    BlockPtr : ^ParamBlockFake;
  22.  begin
  23.   if Aused then
  24.    BlockPtr := @BlockA
  25.   else
  26.    BlockPtr := @BlockB;
  27.   Aused := not Aused;
  28.  
  29.   BlockPtr^[12] := -4;{ set ioRefNum }
  30.   BlockMove(@SynthRec, @BlockPtr^[16], 4);{ ioBuffer }
  31.   BlockMove(@numbytes, @BlockPtr^[18], 4);{ ioReqCount }
  32.  
  33.   while BlockPtr^[8] <> 0 do { wait for ioResult }
  34.    ;
  35. { The following two lines perform  PBWrite(BlockPtr,true) }
  36.   regs[0] := ord(BlockPtr);{ set A0 for generic }
  37.   Generic($A403, regs);{ Write,async }
  38.  end;
  39.  
  40.  
  41.  
  42. { Fill the array SinWave with bytes (chars) }
  43. { representing one cycle of a sine wave }
  44. { note that numbers are from 0 to 255 so that }
  45. { 128 is 'zero' }
  46.  procedure FillSinWave;
  47.   var
  48.    i : integer;
  49.    f, pi : extended;
  50.  begin
  51.   pi := arcTan(1) * 4;
  52.   f := 2 * pi / 256;
  53.   for i := 0 to 255 do
  54.    SinWave[i] := chr(Num2Integer(sin(i * f) * 120 + 128));
  55.  end;
  56.  
  57. begin
  58.  FillSinWave;
  59.  ShowText;
  60.  
  61.  MyFTSynth.mode := FTMode;
  62.  MyFTSynth.SndRec := @MyFTSound;
  63. { Note that all MacPascal Records are initialised }
  64. { by the system to zero.  In another pascal you may }
  65. { have to remember to initialize everything }
  66. { ie. when we start all rates are 0 }
  67.  
  68.  with MyFTSound do
  69.   begin
  70.    Duration := 1000;
  71.    Sound1Wave := @SinWave[0];
  72.    MyStartSound(@MyFTSynth, Sizeof(MyFTSynth), nil);
  73.    rate1 := 1024;
  74.    repeat
  75.     Duration := 1000;
  76.     Sound1Rate := FixRatio(rate1, 256);
  77.     rate1 := rate1 + rate1 div 16;
  78.     writeln('The rate is', rate1, ' div 256, = ', FixRatio(rate1, 256));
  79.     if rate1 >= 2048 then
  80.      rate1 := 1024;
  81.    until Button;
  82.   end;
  83.  StopSound;
  84. end.